home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 12 / Cream of the Crop 12 (Part II) / Cream of the Crop 12 (Part II).iso / OS2 / RXBAS210.ZIP / RXBASMAC.VRM < prev    next >
Encoding:
Text File  |  1995-07-23  |  14.2 KB  |  509 lines
  1. /* Custom mainline for macro */
  2.  
  3.     call RXFuncAdd "VRLoadFuncs", "VROBJ", "VRLoadFuncs"
  4.     call VRLoadFuncs
  5.  
  6.     _VREVersion = SubWord( VRVersion( "VRObj" ), 1, 1 )
  7.     if( _VREVersion < 2.10 )then do
  8.         call VRMessage "", "This program requires VX-REXX version 2.1 to run.", "Error!"
  9.         return 32000
  10.     end
  11.  
  12.     signal on SYNTAX name _VRESyntax
  13.     signal _VREMain
  14.  
  15. _VRESyntax:
  16.     parse source . . _VRESourceSpec
  17.     call VRMessage "", "Syntax error in" _VRESourceSpec "line" SIGL":" ErrorText(rc), "Error!"
  18.     call VRFini
  19.     exit 32000
  20.  
  21. _VREMain:
  22. /*:VRX         Main
  23. */
  24. /*  Main
  25. */
  26. Main:
  27. /*  Process the arguments.
  28.     Get the parent window.
  29. */
  30.     parse source . calledAs .
  31.     parent = ""
  32.     argCount = arg()
  33.     argOff = 0
  34.     if( calledAs \= "COMMAND" )then do
  35.         if argCount >= 1 then do
  36.             parent = arg(1)
  37.             argCount = argCount - 1
  38.             argOff = 1
  39.         end
  40.     end; else do
  41.         call VROptions 'ImplicitNames'
  42.     end
  43.     InitArgs.0 = argCount
  44.     if( argCount > 0 )then do i = 1 to argCount
  45.         InitArgs.i = arg( i + argOff )
  46.     end
  47.     drop calledAs argCount argOff
  48.  
  49. /*  Load the windows
  50. */
  51.     call VRInit
  52.     parse source . . spec
  53.     _VREPrimaryWindowPath = ,
  54.         VRParseFileName( spec, "dpn" ) || ".VRW"
  55.     _VREPrimaryWindow = ,
  56.         VRLoad( parent, _VREPrimaryWindowPath )
  57.     drop parent spec
  58.     if( _VREPrimaryWindow == "" )then do
  59.         call VRMessage "", "Cannot load window:" VRError(), ,
  60.             "Error!"
  61.         _VREReturnValue = 32000
  62.         signal _VRELeaveMain
  63.     end
  64.  
  65. /*  Process events
  66. */
  67.     call Init
  68.     signal on halt
  69.     do while( \ VRGet( _VREPrimaryWindow, "Shutdown" ) )
  70.         _VREEvent = VREvent()
  71.         interpret _VREEvent
  72.     end
  73. _VREHalt:
  74.     _VREReturnValue = Fini()
  75.     call VRDestroy _VREPrimaryWindow
  76. _VRELeaveMain:
  77.     call VRFini
  78. exit _VREReturnValue
  79.  
  80. VRLoadSecondary:
  81.     __vrlsWait = abbrev( 'WAIT', translate(arg(2)), 1 )
  82.     if __vrlsWait then do
  83.         call VRFlush
  84.     end
  85.     __vrlsHWnd = VRLoad( VRWindow(), VRWindowPath(), arg(1) )
  86.     if __vrlsHWnd = '' then signal __vrlsDone
  87.     if __vrlsWait \= 1 then signal __vrlsDone
  88.     call VRSet __vrlsHWnd, 'WindowMode', 'Modal' 
  89.     __vrlsTmp = __vrlsWindows.0
  90.     if( DataType(__vrlsTmp) \= 'NUM' ) then do
  91.         __vrlsTmp = 1
  92.     end
  93.     else do
  94.         __vrlsTmp = __vrlsTmp + 1
  95.     end
  96.     __vrlsWindows.__vrlsTmp = VRWindow( __vrlsHWnd )
  97.     __vrlsWindows.0 = __vrlsTmp
  98.     do while( VRIsValidObject( VRWindow() ) = 1 )
  99.         __vrlsEvent = VREvent()
  100.         interpret __vrlsEvent
  101.     end
  102.     __vrlsTmp = __vrlsWindows.0
  103.     __vrlsWindows.0 = __vrlsTmp - 1
  104.     call VRWindow __vrlsWindows.__vrlsTmp 
  105.     __vrlsHWnd = ''
  106. __vrlsDone:
  107. return __vrlsHWnd
  108.  
  109. /*:VRX         Cancel_Click
  110. */
  111. Cancel_Click: 
  112.     ResultString = ""
  113.     call Quit
  114. return
  115.  
  116. /*:VRX         DisableGenFunc
  117. */
  118. DisableGenFunc: 
  119. /* Set the GenFunc-Objects disabled */
  120.     call VRSet 'DT_Functionname', 'Enabled', 0
  121.     call VRSet 'DT_Para1', 'Enabled', 0
  122.     call VRSet 'DT_Para2', 'Enabled', 0
  123.     call VRSet 'DT_Para3', 'Enabled', 0
  124.     call VRSet 'DT_Para4', 'Enabled', 0
  125.     call VRSet 'DT_Para1B', 'Enabled', 0
  126.     call VRSet 'DT_Para2B', 'Enabled', 0
  127.     call VRSet 'DT_Para3B', 'Enabled', 0
  128.     call VRSet 'DT_Para4B', 'Enabled', 0
  129.     call VRSet 'EF_Para1', 'Enabled', 0
  130.     call VRSet 'EF_Para2', 'Enabled', 0
  131.     call VRSet 'EF_Para3', 'Enabled', 0
  132.     call VRSet 'EF_Para4', 'Enabled', 0
  133.     call VRSet 'CB_Para1', 'Enabled', 0
  134.     call VRSet 'CB_Para2', 'Enabled', 0
  135.     call VRSet 'CB_Para3', 'Enabled', 0
  136.     call VRSet 'CB_Para4', 'Enabled', 0
  137.  
  138. return
  139.  
  140. /*:VRX         DisableSetXXVar
  141. */
  142. DisableSetXXVar: 
  143.     /* Set the SetVar-objects disabled */
  144.     call VRSet 'RB_ConVarA', 'Enabled', 0
  145.     call VRSet 'RB_ConVarB', 'Enabled', 0
  146.     call VRSet 'RB_ConVarC', 'Enabled', 0
  147.     call VRSet 'RB_ConVarD', 'Enabled', 0
  148.     call VRSet 'DT_ConVarTitel', 'Enabled', 0
  149.     call VRSet 'DT_RB_ConVarA', 'Enabled', 0
  150.     call VRSet 'DT_RB_ConVarB', 'Enabled', 0
  151.     call VRSet 'DT_RB_ConVarC', 'Enabled', 0
  152.     call VRSet 'DT_RB_ConVarD', 'Enabled', 0
  153.  
  154. return
  155.  
  156. /*:VRX         Fini
  157. */
  158. Fini:
  159.     window = VRWindow()
  160.     call VRSet window, "Visible", 0
  161.     drop window
  162.  
  163. return ResultString
  164.  
  165. /*:VRX         Halt
  166. */
  167. Halt:
  168.     signal _VREHalt
  169. return
  170.  
  171. /*:VRX         Help_Click
  172. */
  173.  
  174. /* This routine is invoked when the user wants help for
  175.    the dialog... in this case I just invoke the help
  176.    for the REXXBASE called function */
  177.  
  178. Help_Click: 
  179.     address cmd 'view rexxbase'
  180. return
  181.  
  182. /*:VRX         Init
  183. */
  184. Init:
  185.  
  186.     /* Before I display the window, I initialize things.
  187.        Note that InitArgs.1 is the argument string that
  188.        is passed to me from the MTC file. */
  189.  
  190.     ResultString = "" 
  191.  
  192. /* Ask for parameters and goto special routine: */
  193.     parse var InitArgs.2 Function'_'codetype'_'Para1'_'Para2'_'Para3'_'Para4 
  194.  
  195. /* Check out the Layout of the parsed Function */
  196.  
  197. If codetype = 'GenFunc' then 
  198.     If Para3 = '?RXBHEXACT' then
  199.         signal FindRec
  200.     else
  201. signal GenFunc
  202. If codetype = 'SetContVar'  then signal SetContVar
  203. If codetype = 'Getrxerror'  then signal GetRxError
  204. If codetype = 'InitRXBAS'   then signal InitRXBAS
  205.  
  206. Genfunc:
  207. /* -- */
  208.  
  209. /* Set the SetVar-objects disabled */
  210.     call DisableSetXXVar
  211.  
  212. If Para1 = '-' then do
  213.     call VRSet 'DT_Para1', 'Enabled', 0
  214.     call VRSet 'EF_Para1', 'Enabled', 0
  215.     call VRSet 'CB_Para1', 'Enabled', 0
  216. end
  217. If Para2 = '-' then do
  218.     call VRSet 'DT_Para2', 'Enabled', 0
  219.     call VRSet 'EF_Para2', 'Enabled', 0
  220.     call VRSet 'CB_Para2', 'Enabled', 0
  221. end
  222. If Para3 = '-' then do
  223.     call VRSet 'DT_Para3', 'Enabled', 0
  224.     call VRSet 'EF_Para3', 'Enabled', 0
  225.     call VRSet 'CB_Para3', 'Enabled', 0
  226. end
  227. If Para4 = '-' then do
  228.     call VRSet 'DT_Para4', 'Enabled', 0
  229.     call VRSet 'EF_Para4', 'Enabled', 0
  230.     call VRSet 'CB_Para4', 'Enabled', 0
  231. end
  232.  
  233. /* Set the titles of the Generate-Function-objects (GenFunc) */
  234.     call VRSet 'DT_Functionname', 'Caption', 'Function: rexxbase_'Function
  235.     call VRSet 'DT_Para1', 'Caption', Para1
  236.     call VRSet 'DT_Para2', 'Caption', Para2
  237.     call VRSet 'DT_Para3', 'Caption', Para3
  238.     call VRSet 'DT_Para4', 'Caption', Para4
  239.  
  240.     call VRSet 'DT_Para1B', 'Caption', 'Quote 'Para1
  241.     call VRSet 'DT_Para2B', 'Caption', 'Quote 'Para2
  242.     call VRSet 'DT_Para3B', 'Caption', 'Quote 'Para3
  243.     call VRSet 'DT_Para4B', 'Caption', 'Quote 'Para4
  244.  
  245. /* Call the open-window-code */
  246.     signal ViewWindow
  247.  
  248. FindRec:
  249. /* -- */
  250.  
  251. /* Set the SetVar-objects disabled */
  252.     call DisableSetXXVar
  253.  
  254. /* Change the visible objects from GenFunc to FindRec Values */
  255.     call VRSet 'DT_Para3', 'Visible', 0
  256.     call VRSet 'EF_Para3', 'Visible', 0
  257.  
  258.     call VRSet 'DT_Para4B', 'Visible', 0
  259.     call VRSet 'DT_Para4', 'Visible', 0
  260.     call VRSet 'EF_Para4', 'Visible', 0
  261.     call VRSet 'CB_Para4', 'Visible', 0
  262.     
  263.     call VRSet 'DT_Para3B', 'Caption', 'EXACT search'
  264.  
  265. /* Change Para3-Parts to EXACT-Search-Values */
  266.     call VRSet 'DT_Para3B', 'HintText', 'Check this, if RexxBase has to do an EXACT search'
  267.     call VRSet 'CB_Para3', 'HintText', 'Check this, if RexxBase has to do an EXACT search'
  268.  
  269. /* Set the titles of the Generate-Function-objects (GenFunc) */
  270.     call VRSet 'DT_Functionname', 'Caption', 'Function: rexxbase_'Function
  271.     call VRSet 'DT_Para1', 'Caption', Para1
  272.     call VRSet 'DT_Para2', 'Caption', Para2
  273.     call VRSet 'DT_Para3', 'Caption', Para3
  274.     call VRSet 'DT_Para4', 'Caption', Para4
  275.     
  276. /* Call the open-window-code */
  277.     signal ViewWindow
  278.  
  279. SetContVar:
  280.  
  281. /* Set the GenFunc-objects disabled */
  282.     call DisableGenFunc
  283.     call VRSet 'DT_Result', 'Enabled', 0
  284.     call VRSet 'EF_Result', 'Enabled', 0
  285.  
  286. /* Set the titles of the Control-Var objects */
  287. call VRSet 'DT_ConVarTitel', 'Caption', 'Control Variable: rexxbase.'Function
  288.  
  289. If (Para1 \= '-') & (Para2 \= '-') & (Para3 = '-') & (Para4 = '-') then
  290. do
  291.     call VRSet 'RB_ConVarC', 'Enabled', 0
  292.     call VRSet 'RB_ConVarD', 'Enabled', 0
  293.     call VRSet 'DT_RB_ConVarC', 'Enabled', 0
  294.     call VRSet 'DT_RB_ConVarD', 'Enabled', 0
  295.  
  296.     call VRSet 'DT_RB_ConVarC', 'Caption', '-'
  297.     call VRSet 'DT_RB_ConVarD', 'Caption', '-'
  298. end
  299. else do
  300.     call VRSet 'DT_RB_ConVarC', 'Caption', 'Value: 'Para3
  301.     call VRSet 'DT_RB_ConVarD', 'Caption', 'Value: 'Para4
  302. end 
  303.  
  304.     call VRSet 'DT_RB_ConVarA', 'Caption', 'Value: 'Para1
  305.     call VRSet 'DT_RB_ConVarB', 'Caption', 'Value: 'Para2
  306.  
  307. /* Call the open-window-code */
  308.     signal ViewWindow
  309.  
  310. SetFieldVar:
  311. /* Set the GenFunc-Objects disabled */
  312.     call DisableGenFunc
  313.  
  314. /* ...but enable the 1st field for the databasename and the Functiontitle */
  315.     call VRSet 'DT_Para1', 'Enabled', 1
  316.     call VRSet 'EF_Para1', 'Enabled', 1
  317.     call VRSet 'CB_Para1', 'Enabled', 1
  318.     call VRSet 'DT_Para1B', 'Enabled', 1
  319.     call VRSet 'DT_Functionname', 'Caption', 'Field-Variable: '
  320.     
  321. /* ...and if required, the 2nd for the values */
  322. If (translate(Function) = 'FIELDNAME') | (translate(Function) = 'INDEXFIELDNAME') | (translate(Function) = 'INDEXFILENAME') then
  323. do
  324.     call VRSet 'DT_Para2', 'Enabled', 1
  325.     call VRSet 'EF_Para2', 'Enabled', 1
  326.     call VRSet 'CB_Para2', 'Enabled', 1
  327.     call VRSet 'DT_Para2B', 'Enabled', 1
  328.     /* Set the Title */
  329.     call VRSet 'DT_Para2', 'Caption', 'Field Number'
  330. end
  331.  
  332. /* Set the Titles */
  333.     call VRSet
  334.     call VRSet 'DT_Para1', 'Caption', Para1
  335.  
  336. /* Change the visible Objects from SetContVar to SetFieldVar */
  337.     call UnvisibleSetVar
  338.     call VRSet 'DDCB_SetFieldVar', 'Visible', 1
  339.  
  340. /* Call the open-window-code */
  341.     signal ViewWindow
  342.  
  343. GetRxError:
  344. /* Set the resultstring */
  345.     ResultString = 'RxbError = rexxbase.error'
  346.  
  347. /* exit the macro without starting the window */
  348.     call Quit
  349.     signal Ende
  350.  
  351. InitRXBAS:
  352. /* Set the resultstring */
  353.     ResultString = "    rc = rxFuncAdd( rexxbase_init, Rexxbase, 'Rexxbase_Init' )"'0d0a'x"    rc = rexxbase_init()"
  354.  
  355. /* exit the macro without starting the window */
  356.     call Quit
  357.     signal Ende
  358.  
  359. ViewWindow:
  360.     window = VRWindow()
  361.     call VRMethod window, "CenterWindow"
  362.     call VRSet window, "Visible", 1
  363.     call VRMethod window, "Activate"
  364.     drop window
  365.     /* goto the end of the codefile */
  366.     signal Ende
  367.  
  368. Ende:
  369.  
  370. return
  371. /*:VRX         OK_Click
  372. */
  373. OK_Click: 
  374.  
  375. If codetype = 'GenFunc' then signal GenFuncOK
  376. If codetype = 'SetContVar' then signal SetContVarOK
  377.  
  378. GenFuncOK:
  379.  
  380. If Para3 = '?RXBHEXACT' then signal FndRecrd
  381.  
  382.     Para1 = VRGet( 'EF_Para1', 'Value' )
  383.     If Para1 \= '' then 
  384.         If (VRGet( "CB_Para1", "Set" ) = 1) & (Datatype(Para1) \= 'NUM') then xPara1 = '"'Para1'"'
  385.             else xPara1 = Para1
  386.     
  387.     Para2 = VRGet( 'EF_Para2', 'Value' )
  388.     If Para2 \= '' then 
  389.         If (VRGet( "CB_Para2", "Set" ) = 1) & (Datatype(Para2) \= 'NUM') then xPara2 = '"'Para2'"'
  390.             else xPara2 = Para2
  391.  
  392.     Para3 = VRGet( 'EF_Para3', 'Value' )
  393.     If Para3 \= '' then 
  394.         If (VRGet( "CB_Para3", "Set" ) = 1) & (Datatype(Para3) \= 'NUM') then xPara3 = '"'Para3'"'
  395.             else xPara3 = Para3
  396.  
  397.     Para4 = VRGet( 'EF_Para4', 'Value' )
  398.     If Para4 \= '' then 
  399.         If (VRGet( "CB_Para4", "Set" ) = 1) & (Datatype(Para4) \= 'NUM') then xPara4 = '"'Para4'"'
  400.             else xPara4 = Para4
  401.  
  402. If (Para1 = '') & (Para2 = '') & (Para3 = '') & (Para4 = '') then
  403.     Params = ''
  404. If (Para1 \= '') & (Para2 = '') & (Para3 = '') & (Para4 = '') then
  405.     Params = xPara1
  406. If (Para1 \= '') & (Para2 \= '') & (Para3 = '') & (Para4 = '') then
  407.     Params = xPara1', 'xPara2
  408. If (Para1 \= '') & (Para2 \= '') & (Para3 \= '') & (Para4 = '') then
  409.     Params = xPara1', 'xPara2', 'xPara3
  410. If (Para1 \= '') & (Para2 \= '') & (Para3 \= '') & (Para4 \= '') then
  411.     Params = xPara1', 'xPara2', 'xPara3', 'xPara4
  412.  
  413.     /* Create the ResultString */
  414.     result = VRGet( 'EF_result', 'Value' )
  415.     ResultString = 'Rxb'result' = rexxbase_'Function'( 'Params' )'
  416.  
  417. /* Jump to the end of the file */
  418.     signal Fileend
  419.  
  420. FndRecrd:
  421.  
  422.     Para1 = VRGet( 'EF_Para1', 'Value' )
  423.     If Para1 \= '' then 
  424.         If VRGet( "CB_Para1", "Set" ) = 1 then xPara1 = '"'Para1'"'
  425.             else xPara1 = Para1
  426.     
  427.     Para2 = VRGet( 'EF_Para2', 'Value' )
  428.     If Para2 \= '' then 
  429.         If VRGet( "CB_Para2", "Set" ) = 1 then xPara2 = '"'Para2'"'
  430.             else xPara2 = Para2
  431.  
  432.     If VRGet( "CB_Para3", "Set" ) = 1 then
  433.     do
  434.         Para3 = 'EXACT'
  435.     end
  436.     else Para3 = ''
  437.  
  438. If (Para1 \= '') & (Para2 \= '') & (Para3 = '') then
  439.     Params = xPara1', 'xPara2
  440. If (Para1 \= '') & (Para2 \= '') & (Para3 \= '') then
  441.     Params = xPara1', 'xPara2', 'Para3
  442.  
  443.     /* Create the ResultString */
  444.     result = VRGet( 'EF_result', 'Value' )
  445.     ResultString = 'Rxb'result' = rexxbase_'Function'( 'Params' )'
  446.  
  447. /* Jump to the end of the File */
  448.     signal Fileend
  449.  
  450.  
  451. SetContVarOK:
  452. /* Ask, which RadioButton is set */
  453.     setA = VRGet( "RB_ConVarA", "Set" )
  454.     setB = VRGet( "RB_ConVarB", "Set" )
  455.     setC = VRGet( "RB_ConVarC", "Set" )
  456.     setD = VRGet( "RB_ConVarD", "Set" )
  457.  
  458. select
  459.     when setA = 1 then GeneralPara = Para1
  460.     when setB = 1 then GeneralPara = Para2
  461.     when setC = 1 then GeneralPara = Para3
  462.     otherwise GeneralPara = Para4
  463. end
  464.  
  465. /* Create the ResultString */
  466. If Datatype(GeneralPara) = 'NUM' then
  467.     ResultString = 'rexxbase.'Function' = 'GeneralPara
  468. else
  469.     ResultString = 'rexxbase.'Function' = "'GeneralPara'"'
  470.  
  471. /* Jump to the end of the File */
  472.     signal Fileend
  473.  
  474. Fileend:
  475.  
  476. /* Close the codefile and the macro */
  477.     call Quit
  478.     return
  479. /*:VRX         Quit
  480. */
  481. Quit:
  482.     window = VRWindow()
  483.     call VRSet window, "Shutdown", 1
  484.     drop window
  485. return
  486.  
  487. /*:VRX         UnvisibleSetVar
  488. */
  489. UnvisibleSetVar: 
  490.  
  491. /* Make the SetControlVariable Objects unvisible */
  492.     call VRSet 'RB_ConVarA', 'Visible', 0
  493.     call VRSet 'RB_ConVarB', 'Visible', 0
  494.     call VRSet 'RB_ConVarC', 'Visible', 0
  495.     call VRSet 'RB_ConVarD', 'Visible', 0
  496.     call VRSet 'DT_RB_ConVarA', 'Visible', 0
  497.     call VRSet 'DT_RB_ConVarB', 'Visible', 0
  498.     call VRSet 'DT_RB_ConVarC', 'Visible', 0
  499.     call VRSet 'DT_RB_ConVarD', 'Visible', 0
  500.  
  501. return
  502.  
  503. /*:VRX         Window1_Close
  504. */
  505. Window1_Close:
  506.     call Quit
  507. return
  508.  
  509.